home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / tsptp.zip / FIBONACC.PAS < prev    next >
Pascal/Delphi Source File  |  1993-04-09  |  3KB  |  82 lines
  1. (******************************************************************************)
  2. (*                              FIBONACC.PAS                                  *)
  3. (*                                                                            *)
  4. (*  The classic recursive benchmark, implemented with local procedures.       *)
  5. (******************************************************************************)
  6.  
  7. PROGRAM FIBONACCI(Output);
  8.  
  9. (******************************************************************************)
  10. (*                                TIMING                                      *)
  11. (******************************************************************************)
  12.  
  13. (*$IFNDEF TopSpeed *)
  14.  (*%F TRUE   *** Compile for Turbo Pascal ***)
  15.   USES TPBench;
  16.  (*%E*)
  17. (*$ELSE     *** Compile for TopSpeed Pascal ***)
  18.   IMPORT TSBench *;
  19. (*$ENDIF *)
  20.  
  21. (******************************************************************************)
  22.  
  23.   VAR
  24.     FibVal : BmInt;
  25.  
  26.   PROCEDURE Fibo;
  27.   (* Compute the first 25 numbers in the sequence. *)
  28.     FUNCTION Fib(n : BmInt): BmInt;
  29.     (* This local procedure returns the value of the nth fibonacci number *)
  30.     BEGIN
  31.       IF    n = 1 THEN
  32.         Fib := 0
  33.       ELSE IF n = 2 THEN
  34.         Fib := 1
  35.       ELSE
  36.         Fib := Fib(n - 1) + Fib(n - 2);
  37.     END;
  38.  
  39.     VAR
  40.       i : BmInt;
  41.  
  42.   BEGIN
  43.     (*** The 25th number in the sequence is the largest representable with  ***)
  44.     (*** 16 bits.                                                           ***)
  45.     FOR i := 1 TO 25 DO
  46.       FibVal := Fib(i);
  47.   END;
  48.  
  49. BEGIN
  50.   WriteLn('Fibonacci Benchmark');
  51.  
  52. (******************************************************************************)
  53. (*  Compute the looping overhead.  The Dummy procedure must have some side-   *)
  54. (*  effect so that it is not optimised out of existence.                      *)
  55. (******************************************************************************)
  56.  
  57.   StartTimer;                                   (* Start the clock.           *)
  58.  
  59.   REPEAT
  60.     Dummy;
  61.   UNTIL NullTimesUp;
  62.  
  63. (******************************************************************************)
  64. (*  Now run the benchmark.  Note that the Dummy procedure is also called so   *)
  65. (*  that we can eliminate its overhead from the looping overhead.             *)
  66. (******************************************************************************)
  67.  
  68.   StartTimer;                                   (* Start the clock.           *)
  69.  
  70.   REPEAT
  71.     Fibo;
  72.     Dummy
  73.   UNTIL BenchTimesUp;
  74.  
  75. (******************************************************************************)
  76.  
  77.   ReportTimes;
  78.  
  79.   WriteLn;
  80.   WriteLn('Fib(25) = ', FibVal:3);
  81. END.
  82.